home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE10 / INTERNAL / FORMAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-08  |  20.3 KB  |  593 lines
  1. unit Format;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs;
  8.  
  9. type
  10.     ProgressHook = procedure (percent: Integer);
  11.  
  12. const
  13.     { Format capacities }
  14.     DF_360K     =       0;
  15.     DF_12M      =       1;
  16.     DF_720K     =       2;
  17.     DF_14M      =       3;
  18.     DF_28M      =       4;
  19.     DF_Unknown  =       5;
  20.  
  21.     fAbort: Bool = False;                  { in interface so that host can tweak it }
  22.     Progress: ProgressHook = Nil;          { ditto }
  23.  
  24. function IsWindows95: Bool;
  25. function FormatDisk (Drive, Size: Integer): Integer;
  26.  
  27. implementation
  28.  
  29. type
  30.     PBPB = ^BPB;
  31.     BPB = record                 { offsets assume boot sector }
  32.     bsBytesPerSec: Integer;            { 00 bytes per sector }
  33.         bsSecPerClust: Byte;            { 02 sectors per cluster }
  34.         bsResSectors: Integer;            { 03 number of reserved sectors }
  35.         bsFATs: Byte;                { 05 number of file allocation tables }
  36.         bsRootDirEnts: Integer;            { 06 number of root-directory entries }
  37.     bsSectors: Integer;                    { 08 total number of sectors }
  38.         bsMedia: Byte;                    { 0A media descriptor }
  39.         bsFATsecs: Integer;                    { 0B number of sectors per FAT }
  40.         bsSecPerTrack: Integer;                { 0D sectors per track }
  41.         bsHeads: Integer;                    { 0F number of heads }
  42.     bsHidden1: Integer;            { 11 hidden sectors (lo) }
  43.     end;
  44.  
  45.     PDeviceParams = ^DeviceParams;
  46.     DeviceParams = record
  47.     SpecFunc: Byte;                     { 00 }
  48.     DevType: Byte;                { 01 }
  49.     DevAttrs: Integer;            { 02 }
  50.     Tracks: Integer;            { 04 }
  51.     MediaType: Byte;            { 06 }
  52.     bpb: BPB;                    { 07 }
  53.     bsHidden2: Integer;                { 1A }
  54.     HugeSectors: LongInt;                { 1C }
  55.         Reserved: array [0..5] of Char;         { 20 !!! UNDOCUMENTED !!!}
  56.         { Start of TRACKLAYOUT information }
  57.         SectorsPerTrack: Integer;               { 26 }
  58.         TrackLayout: array [0..35] of LongInt;  { 28 }
  59.     end;
  60.  
  61.     PDiskType = ^DiskType;
  62.     DiskType = record
  63.         spc: Byte;              { sectors per cluster }
  64.         rde: Integer;           { number of root-dir entries }
  65.         sec: Integer;           { total number of sectors }
  66.         med: Byte;              { media descriptor }
  67.         spf: Integer;           { number of sectors per FAT }
  68.         spt: Integer;           { sectors per track }
  69.         cls: Integer;           { cluster count }
  70.     end;
  71.  
  72.     RWBlock = record
  73.        rwSpecFunc: Byte;        { special functions (must be zero) }
  74.        rwHead: Integer;         { head to read/write }
  75.        rwCylinder: Integer;     { cylinder to read/write }
  76.        rwFirstSector: Integer;  { first sector to read/write }
  77.        rwSectors: Integer;      { number of sectors to read/write }
  78.        rwBuffer: Pointer;       { address of buffer for read/write data }
  79.     end;
  80.  
  81. const
  82.     { This array maps a logical drive type to a list of     }
  83.     { parameters for that drive.  Assumptions:              }
  84.     { Bytes per sector = 512  Reserved sectors = 1          }
  85.     { Number of FATS = 2      Heads = 2                     }
  86.     { Hidden sectors = 0      Tracks = 80 except 40 for 1st }
  87.  
  88.     DiskTypes: array [0..4] of DiskType = (
  89.  
  90.     (spc:2; rde:112; sec: 720; med:$FD; spf:2; spt: 9; cls:354),   { 360 K }
  91.     (spc:1; rde:224; sec:2400; med:$F9; spf:7; spt:15; cls:2371),  { 1.2 M }
  92.     (spc:2; rde:112; sec:1440; med:$F9; spf:3; spt: 9; cls:713),   { 720 K }
  93.     (spc:1; rde:224; sec:2880; med:$F0; spf:9; spt:18; cls:2847),  { 1.4 M }
  94.     (spc:2; rde:240; sec:5760; med:$F0; spf:9; spt:36; cls:2863)); { 2.8 M }
  95.  
  96.  
  97. const FloppyBoot: array [0..511] of Byte = (
  98.     $EB, $3C, $90, $4D, $53, $44, $4F, $53,
  99.     $35, $2E, $30, $00, $02, $01, $01, $00,
  100.         $02, $E0, $00, $40, $0B, $F0, $09, $00,
  101.         $12, $00, $02, $00, $00, $00, $00, $00,
  102.         $00, $00, $00, $00, $00, $00, $29, $E9,
  103.         $17, $47, $37, $4E, $4F, $20, $4E, $41,
  104.         $4D, $45, $20, $20, $20, $20, $46, $41, 
  105.         $54, $31, $32, $20, $20, $20, $FA, $33,
  106.     $C0, $8E, $D0, $BC, $00, $7C, $16, $07, 
  107.     $BB, $78, $00, $36, $C5, $37, $1E, $56,
  108.     $16, $53, $BF, $3E, $7C, $B9, $0B, $00, 
  109.     $FC, $F3, $A4, $06, $1F, $C6, $45, $FE,
  110.     $0F, $8B, $0E, $18, $7C, $88, $4D, $F9, 
  111.     $89, $47, $02, $C7, $07, $3E, $7C, $FB,
  112.     $CD, $13, $72, $79, $33, $C0, $39, $06,
  113.     $13, $7C, $74, $08, $8B, $0E, $13, $7C,
  114.     $89, $0E, $20, $7C, $A0, $10, $7C, $F7, 
  115.     $26, $16, $7C, $03, $06, $1C, $7C, $13,
  116.     $16, $1E, $7C, $03, $06, $0E, $7C, $83,
  117.     $D2, $00, $A3, $50, $7C, $89, $16, $52,
  118.     $7C, $A3, $49, $7C, $89, $16, $4B, $7C,
  119.     $B8, $20, $00, $F7, $26, $11, $7C, $8B,
  120.     $1E, $0B, $7C, $03, $C3, $48, $F7, $F3, 
  121.     $01, $06, $49, $7C, $83, $16, $4B, $7C,
  122.     $00, $BB, $00, $05, $8B, $16, $52, $7C,
  123.     $A1, $50, $7C, $E8, $92, $00, $72, $1D,
  124.     $B0, $01, $E8, $AC, $00, $72, $16, $8B,
  125.     $FB, $B9, $0B, $00, $BE, $E6, $7D, $F3,
  126.     $A6, $75, $0A, $8D, $7F, $20, $B9, $0B,
  127.     $00, $F3, $A6, $74, $18, $BE, $9E, $7D,
  128.     $E8, $5F, $00, $33, $C0, $CD, $16, $5E, 
  129.     $1F, $8F, $04, $8F, $44, $02, $CD, $19,
  130.     $58, $58, $58, $EB, $E8, $8B, $47, $1A, 
  131.     $48, $48, $8A, $1E, $0D, $7C, $32, $FF,
  132.     $F7, $E3, $03, $06, $49, $7C, $13, $16,
  133.     $4B, $7C, $BB, $00, $07, $B9, $03, $00,
  134.     $50, $52, $51, $E8, $3A, $00, $72, $D8, 
  135.     $B0, $01, $E8, $54, $00, $59, $5A, $58,
  136.     $72, $BB, $05, $01, $00, $83, $D2, $00,
  137.     $03, $1E, $0B, $7C, $E2, $E2, $8A, $2E,
  138.     $15, $7C, $8A, $16, $24, $7C, $8B, $1E, 
  139.     $49, $7C, $A1, $4B, $7C, $EA, $00, $00,
  140.     $70, $00, $AC, $0A, $C0, $74, $29, $B4,
  141.     $0E, $BB, $07, $00, $CD, $10, $EB, $F2,
  142.     $3B, $16, $18, $7C, $73, $19, $F7, $36,
  143.     $18, $7C, $FE, $C2, $88, $16, $4F, $7C,
  144.     $33, $D2, $F7, $36, $1A, $7C, $88, $16, 
  145.     $25, $7C, $A3, $4D, $7C, $F8, $C3, $F9,
  146.     $C3, $B4, $02, $8B, $16, $4D, $7C, $B1,
  147.     $06, $D2, $E6, $0A, $36, $4F, $7C, $8B,
  148.     $CA, $86, $E9, $8A, $16, $24, $7C, $8A,
  149.     $36, $25, $7C, $CD, $13, $C3, $0D, $0A,
  150.     $4E, $6F, $6E, $2D, $53, $79, $73, $74,
  151.     $65, $6D, $20, $64, $69, $73, $6B, $20,
  152.     $6F, $72, $20, $64, $69, $73, $6B, $20,
  153.     $65, $72, $72, $6F, $72, $0D, $0A, $52,
  154.     $65, $70, $6C, $61, $63, $65, $20, $61,
  155.     $6E, $64, $20, $70, $72, $65, $73, $73,
  156.     $20, $61, $6E, $79, $20, $6B, $65, $79,
  157.     $20, $77, $68, $65, $6E, $20, $72, $65,
  158.     $61, $64, $79, $0D, $0A, $00, $49, $4F, 
  159.     $20, $20, $20, $20, $20, $20, $53, $59,
  160.     $53, $4D, $53, $44, $4F, $53, $20, $20,
  161.     $20, $53, $59, $53, $00, $00, $55, $AA );
  162.  
  163. const
  164.     DiskParams: PChar = Nil;                { pointer to disk params }
  165.  
  166. var
  167.     dp: DeviceParams;
  168.     TargetBPB: BPB;
  169.     OldDeviceParams: DeviceParams;          { stash for drive params }
  170.     OldDiskParams: array [0..10] of Char;   { stash for old values }
  171.  
  172. function LUVolumePrim (Drive, Level, Op: Byte; Perm: Word): Integer; assembler;
  173. asm
  174.     mov     ax,$440D        { specify generic IOCTL call }
  175.     mov     bl,Drive        { get drive number in BL     }
  176.     dec     bl              { for compatability, A: = 1  }
  177.     mov     bh,Level        { get lock level in BH       }
  178.     mov     ch,8            { category 8 for drives      }
  179.     mov     cl,Op           { get lock/unlock physical   }
  180.     mov     dx,Perm         { get permissions word       }
  181.     int     21h             { make the call              }
  182.     jc      @@1             { branch if error            }
  183.     xor     ax,ax           { no error - so AX = 0       }
  184. @@1:
  185. end;
  186.  
  187. function LockVolume (Drive: Byte): Integer;
  188. begin
  189.     if IsWindows95 then
  190.     begin
  191.         LockVolume := -1;
  192.         if LUVolumePrim (Drive, 0, $4B, 0) = 0 then
  193.             if LUVolumePrim (Drive, 0, $4B, 4) = 0 then
  194.                 LockVolume := 0;
  195.     end
  196.     else LockVolume := 0;
  197. end;
  198.  
  199. function UnLockVolume (Drive: Byte): Integer;
  200. begin
  201.     if IsWindows95 then
  202.     begin
  203.         UnLockVolume := -1;
  204.          if LUVolumePrim (Drive, 0, $6B, 0) = 0 then
  205.             if LUVolumePrim (Drive, 0, $6B, 0) = 0 then
  206.                 UnLockVolume := 0;
  207.     end
  208.     else UnLockVolume := 0;
  209. end;
  210.  
  211. { Determine if we're running Windows 95 (or later) }
  212.  
  213. function IsWindows95: Bool;
  214. var
  215.     ver: LongInt;
  216.     v: array [0..1] of Word absolute ver;
  217. begin
  218.     ver := GetVersion;
  219.     IsWindows95 := (Swap (v[0]) >= $35F) and (v[1] >= $700);
  220. end;
  221.  
  222. function SenseMediaType (Drive: Byte; fDefault: Bool; pdp: PDeviceParams): Integer;
  223. var
  224.     count: Integer;
  225. begin
  226.     FillChar (pdp^, sizeof (DeviceParams), 0);
  227.     if not fDefault then pdp^.SpecFunc := 1;
  228.  
  229.     asm
  230.         mov     ax,440Dh        { Specify generic IOCTL call     }
  231.         mov     bl,Drive        { BL = wanted drive number       }
  232.         mov     cx,$0860        { Request device parameters      }
  233.         push    ds              { save DS register               }
  234.         lds     dx,pdp          { ds:dx points to param block    }
  235.         call    Dos3Call        { make the call                  }
  236.         pop     ds              { restore DS register            }
  237.         jc      @@1             { if error, return code in AX    }
  238.         xor     ax,ax           { else clear AX register         }
  239. @@1:
  240.         mov     count,ax          { stash result in 'err'          }
  241.     end;
  242.  
  243.     if count <> 0 then SenseMediaType := -1 else
  244.         for count := DF_360K to DF_28M do
  245.             if pdp^.bpb.bsSectors = DiskTypes [count].sec then
  246.             begin
  247.                 SenseMediaType := count;
  248.                 Exit;
  249.             end;
  250. end;
  251.  
  252. procedure FormatInit;
  253. begin
  254.     if DiskParams = Nil then
  255.     begin
  256.         { Reset disk system and get INT $1E vector }
  257.         asm
  258.             mov     ah,$0D                      { specify disk reset     }
  259.             call    Dos3Call                    { do it                  }
  260.             mov     ax,$351E                    { specify INT $1E vector }
  261.             call    DOS3Call                    { result in ES:BX regs   }
  262.             mov     word ptr DiskParams,bx      { set up offset part     }
  263.             mov     word ptr DiskParams+2,es    { set up segment part    }
  264.         end;
  265.  
  266.         { Make a copy of existing disk parameters }
  267.         Move (DiskParams^, OldDiskParams, sizeof (OldDiskParams));
  268.     end;
  269. end;
  270.  
  271. procedure FormatTerminate;
  272. begin
  273.     if DiskParams <> Nil then
  274.     begin
  275.         { Restore old disk parameter values }
  276.         Move (OldDiskParams, DiskParams^, sizeof (OldDiskParams));
  277.         DiskParams := Nil;
  278.     end;
  279. end;
  280.  
  281. function GenSerialNumber: LongInt; assembler;
  282. asm
  283.     mov     ah,$2A              { request system date }
  284.     call    DOS3Call            { result in CX:DX     }
  285.     push    cx                  { push year part      }
  286.     push    dx                  { push month/day      }
  287.     mov     ah,$2C              { request system time }
  288.     call    DOS3Call            { result in CX:DX     }
  289.     pop     ax                  { pop month/day       }
  290.     add     ax,dx               { add to seconds/100  }
  291.     pop     dx                  { pop year part       }
  292.     add     dx,cx               { add hours/minutes   }
  293. end;
  294.  
  295. function WriteAbs (buff: Pointer; Drive, Track, Head, Sec: Integer): Integer;
  296. var
  297.     p: Pointer;
  298.     err: Integer;
  299.     rwb: RWBLOCK;
  300. begin
  301.     rwb.rwSpecFunc := 0;                { always zero }
  302.     rwb.rwHead := Head;                 { head to read/write }
  303.     rwb.rwCylinder := Track;            { track to read/write }
  304.     rwb.rwFirstSector := Sec;           { first sector to read/write }
  305.     rwb.rwSectors := 1;                 { # sectors to read/write }
  306.     rwb.rwBuffer := buff;               { buffer for data }
  307.  
  308.     p := @rwb;
  309.     err := 0;
  310.  
  311.     asm
  312.         mov  ax,$440D               { specify generic IOCTL call }
  313.         mov  bl,byte ptr Drive      { BL = drive number          }
  314.         mov  cx,$0841               { write track to  disk       }
  315.         push ds                     { save DS on stack           }
  316.         lds  dx,p                   { point to param block       }
  317.         call DOS3Call               { do the business...         }
  318.         pop  ds                     { restore DS register        }
  319.         jnc  @@1                    { branch if no error         }
  320.         xor  bx,bx                  { clear BX register          }
  321.         mov  ah,$59                 { request extended error code}
  322.         call DOS3Call               { result in AX register      }
  323.         mov  err,ax                 { stash it                   }
  324. @@1:
  325.     end;
  326.  
  327.     WriteAbs := err;
  328. end;
  329.  
  330. function WriteBootSector (Drive: Byte; SrcBPB: PBPB): Integer;
  331. const
  332.     BPBSig: array [0..7] of Char = 'FAT12   ';
  333. var
  334.     DestBPB: PBPB;
  335.     i: Integer;
  336.     SerNum: LongInt;
  337.     BootSector: array [0..511] of Byte;
  338. begin
  339.     { Get a copy of the default boot record }
  340.     Move (FloppyBoot, BootSector, sizeof (BootSector));
  341.     { Add the BPB for this specific disk capacity }
  342.     DestBPB := @BootSector [11];
  343.     DestBPB^ := SrcBPB^;
  344.     { Init extended boot stuff }
  345.     for i := $1E to $24 do BootSector [i] := 0;
  346.     SerNum := GenSerialNumber;
  347.     Move (SerNum, BootSector [$27], sizeof (SerNum));
  348.     Move (BPBSig, BootSector [$36], 8);
  349.     WriteBootSector := WriteAbs (@BootSector, Drive, 0, 0, 0);
  350. end;
  351.  
  352. function SetMediaType (Drive, Size: Integer): Integer;
  353. var
  354.     err: Byte;
  355.     p: Pointer;
  356.     sec: Integer;
  357.     dp: DeviceParams;
  358. begin
  359.     { Use default diskparams as starting point }
  360.     dp := OldDeviceParams;
  361.     if Size = -1 then dp.SpecFunc := 4 else
  362.     begin
  363.         { Set up 'dp' according to wanted disk size }
  364.         dp.SpecFunc := 5;
  365.         dp.DevType := Size;
  366.         if Size = 3 then dp.DevType := 7;
  367.         if Size = 4 then dp.DevType := 9;
  368.         if Size = 0 then begin dp.Tracks := 40; dp.MediaType := 1; end;
  369.  
  370.         dp.bpb.bsBytesPerSec := 512;
  371.         dp.bpb.bsSecPerClust := DiskTypes [Size].spc;
  372.         dp.bpb.bsResSectors  := 1;
  373.         dp.bpb.bsFATs        := 2;
  374.         dp.bpb.bsRootDirEnts := DiskTypes [Size].rde;
  375.         dp.bpb.bsSectors     := DiskTypes [Size].sec;
  376.         dp.bpb.bsMedia       := DiskTypes [Size].med;
  377.         dp.bpb.bsFATsecs     := DiskTypes [Size].spf;
  378.         dp.bpb.bsSecPerTrack := DiskTypes [Size].spt;
  379.         dp.bpb.bsHeads       := 2;
  380.         dp.bpb.bsHidden1     := 0;
  381.  
  382.         TargetBPB := dp.bpb;
  383.         dp.bsHidden2 := 0;
  384.         dp.HugeSectors := 0;
  385.         dp.SectorsPerTrack := dp.bpb.bsSecPerTrack;
  386.         for sec := 0 to dp.SectorsPerTrack - 1 do
  387.             dp.TrackLayout [sec] := MakeLong (sec + 1, 512);
  388.     end;
  389.  
  390.     { Now tell DOS this is what we want ! }
  391.     p := @dp;
  392.     err := 0;
  393.  
  394.     asm
  395.         mov  ax,$440D           { specify generic IOCTL call }
  396.         mov  bl,byte ptr Drive  { BL = drive number          }
  397.         mov  cx,$0840           { set device parameters      }
  398.         push ds                 { save DS on stack           }
  399.         lds  dx,p               { get pointer to ParamBlock  }
  400.         call DOS3Call           { do the business...         }
  401.         pop  ds                 { restore DS register        }
  402.         jnc  @@1                { branch if no error         }
  403.         mov  err,ah             { stash error code           }
  404. @@1:
  405.     end;
  406.  
  407.     SetMediaType := err;
  408. end;
  409.  
  410. function FormatTrack (Drive, Track, Head: Byte): Integer;
  411. type
  412.     FVBlock = record
  413.                   SpecFunc: Byte;
  414.                   fvHead: Integer;
  415.                   fvCylinder: Integer;
  416.                   fvTracks: Integer;
  417.               end;
  418. var
  419.     err: Integer;
  420.     p: Pointer;
  421.     fvb: FVBlock;
  422. begin
  423.     fvb.SpecFunc := 0;
  424.     fvb.fvHead := Head;
  425.     fvb.fvCylinder := Track;
  426.  
  427.     p := @fvb;
  428.     err := 0;
  429.  
  430.     asm
  431.         mov  ax,$440D      { specify generic IOCTL call }
  432.         mov  bl,Drive      { BL = drive number          }
  433.         mov  cx,$0842      { format track on drive      }
  434.         push ds            { save DS on stack           }
  435.         lds  dx,p          { point to Format block      }
  436.         call DOS3Call      { format the track...        }
  437.         pop  ds            { restore DS register        }
  438.         jnc  @@1           { branch if no error         }
  439.         xor  bx,bx         { clear BX register          }
  440.         mov  ah,$59        { request extended error code}
  441.         call DOS3Call      { result in AX register      }
  442.         mov  err,ax        { stash it                   }
  443. @@1:
  444.     end;
  445.  
  446.     if not (err in [0, $17, $1B, $1F]) then err := -1;
  447.     FormatTrack := err;
  448. end;
  449.  
  450. function InitVolume (Drive: Integer; pDisk: PDiskType): Integer;
  451. var
  452.     buff: array [0..511] of Byte;
  453.     count1, count2, trk, sec, hed: Integer;
  454.  
  455.     function PutSector: Integer;
  456.     var
  457.         err: Integer;
  458.     begin
  459.         err := WriteAbs (@buff, Drive, trk, hed, sec);
  460.  
  461.         Inc (sec);
  462.         { End of this track ? }
  463.         if sec > pDisk^.spt - 1 then
  464.         begin
  465.             sec := 0;
  466.             Inc (hed);
  467.             { End of this cylinder ? }
  468.             if hed > 1 then
  469.             begin
  470.                 hed := 0;
  471.                 Inc (trk);
  472.             end;
  473.         end;
  474.  
  475.         FillChar (buff, sizeof (buff), 0);
  476.         PutSector := err;
  477.     end;
  478.  
  479. begin
  480.     InitVolume := -1;                       { assume failure }
  481.     trk := 0; hed := 0; sec := 1;           { point at first FAT }
  482.  
  483.     { Write first and second FAT's to disk }
  484.     for count1 := 1 to 2 do
  485.     begin
  486.         FillChar (buff, sizeof (buff), 0);
  487.         buff [0] := pDisk^.med;
  488.         buff [1] := $ff;
  489.         buff [2] := $ff;
  490.  
  491.         for count2 := 1 to pDisk^.spf do
  492.             if PutSector <> 0 then Exit;
  493.     end;
  494.  
  495.     { Write empty directory blocks to disk }
  496.     count1 := ((pDisk^.rde * $20) + 511) div 512;
  497.     for count2 := 1 to count1 do
  498.         if PutSector <> 0 then Exit;
  499.     InitVolume := 0;
  500. end;
  501.  
  502. function FormatDisk (Drive, Size: Integer): Integer;
  503. label
  504.     Stop;
  505. var
  506.     pDisk: PDiskType;
  507.     TracksLeft, TotTracks, CurTrk, CurHead,
  508.     err, SysSectors, DefSize, DiskSize: Integer;
  509.  
  510.     function Spin: Bool;
  511.     begin
  512.         Application.ProcessMessages;
  513.         if Assigned (Progress) then Progress (CurTrk * 200 div TotTracks);
  514.         Spin := not fAbort;
  515.     end;
  516.  
  517. begin
  518.     { Assume failure and validate drive number }
  519.     FormatDisk := -1;
  520.     fAbort := False;
  521.     if not Drive in [1..2] then Exit;
  522.  
  523.     { Stash current drive setup }
  524.     DefSize := SenseMediaType (Drive, True, @OldDeviceParams);
  525.  
  526.     { If we're quick-formatting, then auto-sense the current media }
  527.     DiskSize := Size;
  528.     if DiskSize = -1 then DiskSize := SenseMediaType (Drive, False, @dp);
  529.  
  530.     { If media not present or other error, then slow-format }
  531.     if DiskSize = -1 then
  532.     begin
  533.         if MessageDlg ('Can''t quick-format this disk.  Format to default capacity?',
  534.             mtConfirmation, [mbYes, mbNo], 0) = mrNo then Exit;
  535.         DiskSize := DefSize;
  536.     end;
  537.  
  538.     { Establish wanted media size with DOS }
  539.     if SetMediaType (Drive, DiskSize) <> 0 then Exit;
  540.  
  541.     { Grab disk params table }
  542.     pDisk := @DiskTypes [DiskSize];
  543.     if LockVolume (Drive) <> 0 then Exit;
  544.     FormatInit;
  545.  
  546.     { Tweak disk params table for wanted format }
  547.     DiskParams [4] := Chr (pDisk^.spt);
  548.     if pDisk^.spt = 15 then DiskParams [7] := Chr ($54)
  549.     else DiskParams [7] := Chr ($50);
  550.  
  551.     { Now we can format the tracks }
  552.     if DiskSize = 0 then TotTracks := 80 else TotTracks := 160;  { Heads=2! }
  553.     SysSectors := (2 * pDisk^.spf) + (((pDisk^.rde * 32) + 511) div 512) + 1;
  554.     TracksLeft := TotTracks; CurHead := 0; CurTrk := 0;
  555.  
  556.     { Only format tracks if not quick formatting }
  557.     if Size <> -1 then
  558.     begin
  559.         { Main formatting loop }
  560.         while TracksLeft <> 0 do
  561.         begin
  562.             { Let somebody else get a look-in ! }
  563.             if not Spin then goto Stop;
  564.             if FormatTrack (Drive, CurTrk, CurHead) <> 0 then goto Stop;
  565.  
  566.             Dec (TracksLeft);
  567.             Inc (CurHead);
  568.             if CurHead >= 2 then
  569.             begin
  570.                 CurHead := 0;
  571.                 Inc (CurTrk);
  572.             end;
  573.         end;
  574.     end;
  575.  
  576.     { Write a new boot sector to the disk }
  577.     WriteBootSector (Drive, @TargetBPB);
  578.     { Let somebody else get a look-in ! }
  579.     if not Spin then goto Stop;
  580.     { Write FAT and directory information }
  581.     if InitVolume (Drive, pDisk) = 0 then FormatDisk := 0;
  582.     { If quick formatting, be sure to update Progress marker }
  583.     if (Size = -1) and Assigned (Progress) then Progress (100);
  584.  
  585. Stop:
  586.     SetMediaType (Drive, -1);
  587.     FormatTerminate;
  588.     UnlockVolume (Drive);
  589. end;
  590.  
  591. end.
  592.  
  593.